{
 "metadata": {
  "author": "Douglas Bates",
  "language": "Julia",
  "name": "",
  "signature": "sha256:d22541d58759f71de5558f79f7fb1c34d1b156a356509b60f2b938bdebad0329"
 },
 "nbformat": 3,
 "nbformat_minor": 0,
 "worksheets": [
  {
   "cells": [
    {
     "cell_type": "heading",
     "level": 1,
     "metadata": {},
     "source": [
      "RCall: Mapping functions from the C API for R"
     ]
    },
    {
     "cell_type": "markdown",
     "metadata": {},
     "source": [
      "_Douglas Bates_\n",
      "\n",
      "_February 24, 2015_"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "using DataArrays,DataFrames,RCall"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 1
    },
    {
     "cell_type": "markdown",
     "metadata": {},
     "source": [
      "The file defining the C API for R is `R.h` in the directory whose name is `ENV[\"R_INCLUDE_DIR\"]`.  In my case this is"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "joinpath(ENV[\"R_INCLUDE_DIR\"],\"R.h\")"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "pyout",
       "prompt_number": 2,
       "text": [
        "\"/usr/share/R/include/R.h\""
       ]
      }
     ],
     "prompt_number": 2
    },
    {
     "cell_type": "markdown",
     "metadata": {},
     "source": [
      "`R.h` causes inclusion of several other header files from that directory, the most important of which is `Rinternals.h`.\n",
      "\n",
      "A typical function declaration in `Rinternals.h` is\n",
      "```c\n",
      "Rboolean Rf_isVector(SEXP);\n",
      "```\n",
      "\n",
      "We can call this function directly from Julia using `ccall`.  We define a Julia function `isRVector` to do this."
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "isRVector(s::SEXPREC) = ccall((:Rf_isVector,libR),Bool,(Ptr{Void},),s.p)"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "pyout",
       "prompt_number": 3,
       "text": [
        "isRVector (generic function with 1 method)"
       ]
      }
     ],
     "prompt_number": 3
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "\"library(robustbase)\" |> rcopy"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "pyout",
       "prompt_number": 4,
       "text": [
        "8-element Array{ASCIIString,1}:\n",
        " \"robustbase\"\n",
        " \"stats\"     \n",
        " \"graphics\"  \n",
        " \"grDevices\" \n",
        " \"utils\"     \n",
        " \"datasets\"  \n",
        " \"methods\"   \n",
        " \"base\"      "
       ]
      }
     ],
     "prompt_number": 4
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "m1 = reval(\"m1 <- lmrob(Y ~ ., coleman, setting = 'KS2011')\")"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "pyout",
       "prompt_number": 5,
       "text": [
        "VecSxp(-536870733,Ptr{Void} @0x000000000a4c0160,Ptr{Void} @0x000000000b8433c0,Ptr{Ptr{None}} @0x000000000b8433e8,22,0)"
       ]
      }
     ],
     "prompt_number": 5
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "isRVector(m1)  # true because m1 is a list"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "pyout",
       "prompt_number": 6,
       "text": [
        "true"
       ]
      }
     ],
     "prompt_number": 6
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "isRVector(m1[1]) # true because the coefficients are a numeric vector"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "pyout",
       "prompt_number": 7,
       "text": [
        "true"
       ]
      }
     ],
     "prompt_number": 7
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "typeof(m1[18])  # the \"call\" component is a LANGSXP (function call)"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "pyout",
       "prompt_number": 8,
       "text": [
        "LangSxp (constructor with 2 methods)"
       ]
      }
     ],
     "prompt_number": 8
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "isRVector(m1[18]) # a LANGSXP does not behave like a vector"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "pyout",
       "prompt_number": 9,
       "text": [
        "false"
       ]
      }
     ],
     "prompt_number": 9
    },
    {
     "cell_type": "markdown",
     "metadata": {},
     "source": [
      "We can simplify many of the `ccall` expressions by creating a `convert` method to produce a `Ptr{Void}` from the Julia `SEXP` type\n",
      "```julia\n",
      "Base.convert(::Type{Ptr{Void}},s::SEXP) = s.p\n",
      "```\n",
      "\n",
      "In fact, because all these predicate functions have the same signature, we can (and do) define corresponding Julia functions through metaprogramming.\n",
      "```\n",
      "## predicates applied to an SEXP\n",
      "for sym in (:isArray,:isComplex,:isEnvironment,:isExpression,\n",
      "            :isFactor,:isFrame,:isFree,:isFunction,:isInteger,\n",
      "            :isLanguage,:isList,:isLogical,:isSymbol,:isMatrix,\n",
      "            :isNewList,:isNull,:isNumeric,:isNumber,:isObject,\n",
      "            :isOrdered,:isPairList,:isPrimitive,:isReal,\n",
      "            :isS4,:isString,:isTs,:isUnordered,:isUnsorted,\n",
      "            :isUserBinop,:isValidString,:isValidStringF,\n",
      "            :isVector,:isVectorAtomic,:isVectorizable,\n",
      "            :isVectorList)\n",
      "    @eval $sym(s::SEXP) =  ccall(($(string(\"Rf_\",sym)),libR),Bool(Ptr{Void},),s)\n",
      "end\n",
      "```\n",
      "\n",
      "Many of these functions; `isComplex`, `isExpression`, `isList`, `isLogical`, `isNewList`,`isSymbol`, `isReal` and `isS4`, are redundant because the Julia `SEXP` type is a templated type with the code built-in.  At present only a few of these functions are exported.\n",
      "\n",
      "Note that the meaning of `Array` is slightly different for `R` and for `Julia`.  In `Julia` a vector is an `Array`.  In `R` a vector is an `Array` only if it has a `dim` attribute. "
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "RCall.isArray(m1[1])  # coefficients are a vector but not an R array"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "pyout",
       "prompt_number": 10,
       "text": [
        "false"
       ]
      }
     ],
     "prompt_number": 10
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "RCall.isArray(m1[22]) # the model matrix is an array"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "pyout",
       "prompt_number": 11,
       "text": [
        "true"
       ]
      }
     ],
     "prompt_number": 11
    },
    {
     "cell_type": "heading",
     "level": 2,
     "metadata": {},
     "source": [
      "Creating and manipulating Julia SEXPREC objects"
     ]
    },
    {
     "cell_type": "markdown",
     "metadata": {},
     "source": [
      "There are several methods for the `sexp` generic function that create a Julia SEXP from other types of Julia objects.\n",
      "\n",
      "For example, an R symbol is retrieved (installing it in the symbol table if necessary) via a C function whose signature is\n",
      "```c\n",
      "SEXP Rf_install(const char *);\n",
      "```\n",
      "\n",
      "We define an `sexp` method for the `Symbol` type in Julia as\n",
      "```julia\n",
      "function sexp(s::Symbol)\n",
      "    sexp(ccall((:Rf_install,libR),Ptr{Void},(Ptr{Uint8},),\n",
      "               string(s)))\n",
      "end\n",
      "```\n",
      "\n",
      "(If you know about R's garbage collection and are wondering why the result is not protected, objects in the symbol table are never garbage collected.)"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "sexp(:foo)"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "pyout",
       "prompt_number": 12,
       "text": [
        "SymSxp(1,Ptr{Void} @0x000000000a36adf8,Ptr{Void} @0x000000000a4c0048,Ptr{Void} @0x000000000a4c0080,Ptr{Void} @0x0000000005406268,Ptr{Void} @0x000000000a36adc0,Ptr{Void} @0x000000000a36adf8)"
       ]
      }
     ],
     "prompt_number": 12
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "rprint(ans)"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "output_type": "stream",
       "stream": "stdout",
       "text": [
        "foo\n"
       ]
      }
     ],
     "prompt_number": 13
    }
   ],
   "metadata": {}
  }
 ]
}